perm filename PARCPU.SAI[KA,SYS] blob
sn#706004 filedate 1983-04-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DEFINE
C00004 00003 in PASS2.SAI
C00007 00004
C00008 00005
C00011 00006
C00013 00007 PASS2.SAI
C00022 00008
C00027 ENDMK
C⊗;
DEFINE
OLDMIC=[false], NEWMIC=[true], comment EARS/PRESS switch;
VBPIMIC=[2540], HBPIMIC=[2540],
PARCODES = [
DEFINE
ELShowCharactersShort = '0,
ELSetSpaceXShort = '140,
ELFont = '160,
ELSetX = '356,
ELSetY = '357,
ELShowCharacters = '360,
ELSetSpaceX = '364,
ELResetSpace = '366,
ELShowRectangle = '376,
ELNop = '377,
MEOL = -1,
MICOUT(ARRY, COUNT) = [SOUT16(LISTCHAN, ARRY, COUNT)] ;
],
PARCARRAYS = [
INTEGER PDIX, OUTCOUNT, TLIX, DLIX, DLREC, PDREC, DDREC;
INTEGER dlgone, DLbeg, ELbeg, SpaceX, BrkToChange;
INTEGER XPNeed, YPNeed, Pass2ScriptLevel, wordbreak;
INTEGER DLBPRESET ; TES 11/17/74;
INTEGER PressBug;
INTEGER ARRAY TL[0:'4000], DL,PD[0:'2000], NILS[0:'400] ;
],
Comment in PASS2.SAI
SOUT16 -- write a bunch of 16-bit words onto the output file.
Words must be organized in low-order 16 bits of words in
the array. Keeps track of total number of words written
in OUTCOUNT.
MICPAD -- pads out file to next 256-word record, and
returns record number of next record.
WISHPMAP -- This function is provided rather than a
PMAPped way to write a file. It assumes that
a number of 8-bit bytes have been deposited in
a buffer in high core by IDPBing through DLBP.
It moves these bytes
into DL 16 bits at a time and calls SOUT16.
;
PARCOUT = [
SIMPLE PROCEDURE SOUT16(INTEGER CHAN; INTEGER ARRAY LOC; INTEGER COUNT) ;
BEGIN TES 4/20/75 ;
OUTCOUNT←OUTCOUNT+COUNT;
START!CODE
PUSH '17,CHAN;
PUSHJ '17,CVJFN;
HRLI 2,'004400;
HRR 2,LOC;
subi 2,1;
MOVN 3, COUNT;
SOUT;
END;
END "SOUT16";
SIMPLE INTEGER PROCEDURE MICPAD ;
BEGIN
INTEGER N ;
N ← 256 - OUTCOUNT MOD 256 ;
IF N < 0 THEN WARN("PUB BUG -- TOO MUCH IN A RECORD") ;
IF N < 256 THEN MICOUT(NILS, N) ;
IF OUTCOUNT MOD 256 THEN
WARN("PUB BUG -- TOO LITTLE IN A RECORD") ;
RETURN(OUTCOUNT DIV 256) ; COMMENT NO. OF NEXT RECORD ;
END "MICPAD" ;
SIMPLE PROCEDURE WISHPMAP ;
BEGIN "WISHPMAP"
INTEGER DLOC, SDP, COUNT ;
DLOC ← LOCATION(DL[0]) ;
SDP ← '042000677777 ;
WHILE RH(SDP) < RH(DLBP) DO
BEGIN
COUNT ← 2 * (1 +
(IF SDP LAND '777000 =
(DLBP LAND '777000)-'1000
THEN DLBP LAND '777 ELSE '777)) ;
START!CODE "WISH"
LABEL LOOP ;
MOVN '13,COUNT ;
MOVE '14,DLOC ;
HRL '14,'13 ;
MOVE '13, SDP ;
LOOP: ILDB '15, '13 ;
MOVEM '15, 0('14) ;
AOBJN '14, LOOP ;
MOVEM '13,SDP ;
END "WISH" ;
MICOUT(DL, COUNT) ;
END ;
END "WISHPMAP" ;
Comment Routines for dealing with the EL;
simple procedure ELByte (integer b);
begin integer j;
j←TLIX div 2;
b←b land '377;
TL[j]←(if (TLIX land 1)=0 then b lsh 8 else b+TL[j]);
TLIX←TLIX+1;
end;
simple procedure ELWord (integer b);
begin ELByte(b lsh -8); ELByte(b) end;
simple procedure ELDWord (integer b);
begin ELWord(b lsh -16); ELWord(b) end;
simple integer procedure ELPos;
return (TLIX);
procedure ELOut;
begin integer i,j;
j←TLIX; if (j land 1)=1 then warn("EL bug");
j←j div 2;
MICOUT(TL, j);
TLIX←0;
end;
Comment Routines for putting things into the EL.;
simple procedure SetPosD(integer code,pos);
begin
if code=ELSetX then XPNeed←-1 else YPNeed←-1;
ELByte(code);
ELWord(pos);
end;
simple procedure Show;
if dlgone then begin
if XPNeed neq -1 then SetPosD(ELSetX,XPNeed);
if YPNeed neq -1 then SetPosD(ELSetY,YPNeed);
while dlgone do begin
integer i;
i←dlgone min 255;
if i leq 32 then ELByte(ELShowCharactersShort+i-1)
else begin
ELByte(ELShowCharacters);
ELByte(i);
end;
dlgone←dlgone-i;
end;
end;
simple procedure SetPos(integer code,pos);
begin
Show; comment flush out existing characters;
if code=ELSetX then XPNeed←pos else YPNeed←pos;
end;
simple procedure SetSpace(integer s);
begin
Show;
SpaceX←s;
if s<2048 then ELWord((ELSetSpaceXShort lsh 8)+s) else
begin
ELByte(ELSetSpaceX);
ELWord(s);
end;
end;
simple procedure BCPLString(string s; integer maxlen);
begin integer i;
ELByte(maxlen min length(s));
for i←1 thru maxlen do
ELByte(if i>length(s) then 0 else s[i for 1]);
end;
Comment The routine that computes how much to go up/down
for super/sub scripts;
simple integer procedure SubSuperAmt(integer dir,rasthigh);
begin integer firstone,nlevel,dosuper,ix;
nlevel←Pass2ScriptLevel+dir;
firstone←(Pass2ScriptLevel=0) or (nlevel=0);
dosuper←(Pass2ScriptLevel>0) or (nlevel>0);
ix←(if firstone then 0 else 2)+(if dosuper then 0 else 4);
Pass2ScriptLevel←nlevel;
Comment Value is a+b*high/1000, where a in micas;
return(SCRIPTPARAMS[ix]+(SCRIPTPARAMS[ix+1]*rasthigh)%1000);
end;
],
Comment
Body of INITIALAPPD(s) and APPD(s), the two basic routines
that write out text characters. This routine IDPB's chars
into the output buffer, and accounts the widths as it does
so. Current X position is saved in CURRENTX, and
is updated. CW must point to an array of widths (micas).
;
PARCAPPD = [
IF MICRO THEN TES 10/9/74 REVISED FOR CURRENTX ;
BEGIN "MAPPD"
INTEGER SRC,len,spcnt ;
len←LENGTH(S);
IF len=0 THEN RETURN(CHAR) ;
if PressBug then Outstr(s);
spcnt←0;
QUICK!CODE "MAPPEND"
LABEL LOOP ;
DEFINE X=['13], BYTE=['14], CNT=['15];
MOVEI CNT, S ;
MOVE X, 0(CNT) ;
MOVEM X, SRC ;
HRRZ CNT,-1(CNT) ;
MOVE X, CURRENTX ;
LOOP:
ILDB BYTE, SRC ;
cain byte,SP;
aos spcnt;
IDPB BYTE, DLBP ;
ADD BYTE, CW ;
SKIPLE 0(BYTE) ;
ADD X, 0(BYTE) ; COMMENT ADD CHARACTER WIDTH ;
SOJG CNT, LOOP ;
MOVEM X, CURRENTX ;
END "MAPPEND" ;
DLBPRESET ← -1 ; TES 11/17/74;
if spcnt neq 0 and wordbreak=false and SpaceX neq -1 then begin
Show; comment put out chars not including these;
ELByte(ELResetSpace);
dlgone←dlgone+len;
Show;
SetSpace(SpaceX);
end else dlgone←dlgone+len;
RETURN(CHAR+len) ;
END "MAPPD"
ELSE
],
Comment PASS2.SAI
Used to change fonts. Font number to switch to
is in WHICH (mapped via FNDNUMBER to PRESS font).
;
PARCFONT = [
IF MICRO THEN
IF 0 LEQ WHICH LEQ 15 THEN
BEGIN
Show;
ELByte(ELFont + FNTNUMBER[WHICH]) ;
WHICH←FNTFIL[WHICH] ; MAKEBE(WHICH,CW) ; TES 10/9/74 ;
END
ELSE WARN("FONT NUMBER OUT OF RANGE")
ELSE IF WHICH>9 THEN WARN("Font ignored")
ELSE CTRL(6&(WHICH+"0"))
],
PARCLINE = [
SIMPLE PROCEDURE MICTAB(INTEGER N) ;
SetPos(ELSetx,CURRENTX←N+TLFTMAR) ;
SIMPLE PROCEDURE OPENLINE(INTEGER FSTTAB, XFSTFONT) ;
BEGIN "OPENLINE" TES 10/17/74 XFSTFONT ;
dlgone←0; ELbeg←ELPos;
DLbeg ← BYTECOUNT(DLBP, DLBP1) ;
IF XFSTFONT<0 THEN CURRENTY ← LINEY ← BOTMAR + RASTPHIGH - LINE*RASTLHIGH ;
IF XFSTFONT geq 0 then ELByte(ELFont+FNTNUMBER[XFSTFONT]);
SetPos(ELSetY, CURRENTY);
Pass2ScriptLevel←0; wordbreak←false;
MICTAB(FSTTAB) ;
BrkToChange←0; SpaceX←-1;
if totbrks neq 0 and SHORTM > 0 then
begin integer m;
m←SHORTM div totbrks;
n←SHORTM mod totbrks;
if n neq 0 then begin
m←m+1;
BrkToChange←n;
end;
if PressBug then Outstr("=="&cvs(totbrks)&","&cvs(shortm)&","&cvs(m));
SetSpace(m);
end;
END "OPENLINE" ;
SIMPLE PROCEDURE CLOSELINE ;
IF DLBPRESET=-1 THEN
BEGIN "CLOSEL"
IF FULSTR(SR) THEN BEGIN MICTAB(RGTMAR-TLFTMAR) ; APPD(SR) ; SR←NULL END ;
Show;
if (ELPos land 1)=1 then ELByte(ELNop);
ELWord(0);
ELDWord(DLbeg);
ELDWord(BYTECOUNT(DLBP,DLBP1)-DLbeg);
ELDWord(0); comment XeYe;
ELWord(TLFTMAR); ELWord(LINEY-RASTLHIGH/3);
ELWord(RGTMAR-TLFTMAR); ELWord(RASTLHIGH);
ELWord(1+(ELPos-ELbeg) div 2);
END "CLOSEL"
ELSE DLBP ← DLBPRESET ; TES 11/17/74;
],
PARCBAR = [
begin integer x,i;
x←0;
for i←1 thru length(s) do x←x+CW[s[i for 1]];
Show;
SetPosD(ELSetX,CURRENTX);
SetPosD(ELSetY,CURRENTY-80);
ELByte(ELShowRectangle);
ELWord(x); ELWord(20);
SetPos(ELSetY,CURRENTY);
APPD(s);
end
],
PARCSUPER = [
SetPos(ELSetY,(CURRENTY←CURRENTY+SubSuperAmt(1,RASTLHIGH)))
],
PARCSUB = [
SetPos(ELSetY,(CURRENTY←CURRENTY-SubSuperAmt(-1,RASTLHIGH)))
],
PARCRIGHT = [
IF MICRO THEN
BEGIN
CURRENTX ← CURRENTX + F ; TES 10/9/74 ;
SetPos(ELSetX, CURRENTX);
END ELSE
],
PARCTAB = [
ELSE IF F+TLFTMAR neq CURRENTX THEN
SetPos(ELSetX,CURRENTX←F+TLFTMAR)
],
PARCONVERSION = [ TES REPLACED PARCPICHAR BY THIS FOR AUTOPACK ;
BEGIN
INTEGER NEWCOPYNUMBER, N ;
N ← S[2 FOR 1] ;
NEWCOPYNUMBER ← IF N=0 THEN 0 ELSE CVD(S[3 TO 2+N]) ;
IF NEWCOPYNUMBER NEQ COPYNUMBER THEN
BEGIN
COPYNUMBER ← NEWCOPYNUMBER ;
Comment !!!!!! need something eventually !!!! ;
END ;
END
],
PARCLEFT = [
SetPos(ELSetX,CURRENTX←CURRENTX - F*CHARW MAX 0)
],
PARCJUST = [
begin "parcj" integer a,nx;
Comment F has desired mica spacing, using an exact computation.
We will actually put out SpaceX, so record accordingly. After
a while, we decrease SpaceX to get line to come out exactly right;
nx←CURRENTX←CURRENTX+F;
if PressBug then Outstr("="&cvs(F)&","&cvs(SpaceX));
if a geq 0 and (BRKS-1=totbrks or (a=1 and BRKS=totbrks div 2)) then
SetPos(ELSetX, CURRENTX)
else begin
wordbreak←true; comment don't think space is quoted;
APPD(SP);
wordbreak←false;
end;
CURRENTX←nx; comment because APPD updates it;
BrkToChange←BrkToChange-1;
if BrkToChange=0 then SetSpace(SpaceX-1);
end
],
PARCOVLY = [
IF MICRO THEN
BEGIN integer tx ;
K ← LDB(DLBP) ; COMMENT LAST CHARACTER OUTPUT ;
IF K>'177 THEN
WARN("ATTEMPT TO OVERLAY A DIRECTIVE")
ELSE BEGIN
F ← LOP(SEG[G+1]) ;
tx←CURRENTX;
SetPos(ELSetX,tx-CW[K]);
APPD(F);
CURRENTX←tx;
SetPos(ELSetX,CURRENTX);
END ;
END
ELSE CTRL('10)
],
PARCLOSE = [
IF MICRO THEN CLOSELINE ;
],
PARCPAGE = [
IF MICRO THEN
IF ELPos = 0 THEN COMMENT BLANK PAGES ARE SUPPRESSED ;
ELSE BEGIN "PUTPD"
APPD('0&'0);
while (BYTECOUNT(DLBP,DLBP1) mod 4) neq 0 do APPD(0);
WISHPMAP ; COMMENT WRITE OUT DL ;
ELOut; comment write out EL;
PD[PDIX] ← 0 ;
PD[PDIX+1] ← DLREC ;
dlgone←outcount mod 256;
PD[PDIX+3] ← (if dlgone=0 then 0 else 256-dlgone);
DLREC ← MICPAD ;
PD[PDIX+2] ← DLREC-PD[PDIX+1] ;
PDIX ← PDIX + 4 ;
DLgone←0;
END "PUTPD"
ELSE
],
PARCDOC = [
IF MICRO THEN
BEGIN "FDTODD" integer f,logdir;
for f←lofont thru hifont do if FULSTR(FNTNAME[f]) then
begin string fam; integer pt,face;
ELWord(16);
ELWord(FNTNUMBER[f]);
ELByte(0); ELByte(127);
FONTTYPE(FNTNAME[f], fam, pt, face);
BCPLString(fam, 19);
ELByte(face); ELByte(0);
ELWord(pt); ELWord(0);
end;
ELWord(0);
ELOut;
PDREC←MICPAD; Comment next record is part directory;
PD[PDIX]←1;
PD[PDIX+1]←DLREC;
PD[PDIX+2]←PDREC-DLREC;
PDIX←PDIX+4;
MICOUT(PD,PDIX);
DDREC←MICPAD;
ELWord(27183);
ELWord(DDREC+1);
ELWord(PDIX div 4);
ELWord(PDREC);
ELWord(DDREC-PDREC);
ELWord(-1);
Comment Alto-format date in words 6,7. Algorithm courtesy
E. Fiala: take lh of GTAD (days since 17 Nov 1858), subtract to
get days since 1 Jan 1901, convert to seconds, and add in seconds
in the current day (rh of GTAD);
i←GTAD; ELDWord(((i lsh -18)-15385)*(3600*24)+(i land '777777));
ELWord(1); ELWord(1); comment copy numbers;
for i←10 thru '177 do ELWord(-1);
BCPLString(LISTFILE, 51);
GJINF(logdir,DUMMY,DUMMY);
BCPLString(DIRST(logdir),31);
BCPLString(ODTIM(-1,-1),37);
ELOut;
MICPAD;
SFBSZ(LISTCHAN, 8) ;
END "FDTODD" ;
],
Comment Following functions in FONTS.SAI (passes 1 and 2) ;
PARCMIC = [
IF ITS(PRESS) THEN DEVICE←MIC ELSE
],
PARCFONTTYPE = [
begin "PFT" dcs 7/78;
integer state,k; string m;
m←n;
state←0;
mod←0; pt←0; fam←null;
while length(m) do begin
k←lop(m);
if "a" leq k leq "z" then k←k-"a"+"A";
if "0" leq k leq "9" then
begin
if state=0 then state←1
end else begin
if state=1 then state←2
end;
if state=0 then fam←fam&k;
if state=1 then pt←pt*10+k-"0";
if state=2 then begin
if k="B" then mod←mod lor 2;
if k="I" then mod←mod lor 1;
end;
end;
if state=0 then Outstr("Illegal font spec. "&n&crlf);
end "PFT";
],
PARCFILE = [
begin "PF" dcs 7/78;
integer i,w,t,bsiz,famno,pt,face,sl,len,ffn,bbc,siz,rota,pos,bc,ec,bpos;
real scale; string fam,sn;
for i←1 thru 127 do CW[i]←-1;
FONTTYPE(nam, fam, pt, face);
bsiz←-1; famno←-1;
do begin "readix"
w←bytein(chan);
t←w lsh -12; len←(w land '7777)-1;
if t=1 and famno=-1 then begin "famlook"
famno←bytein(chan);
for i←1 thru len-1 do begin
w←bytein(chan);
if i=1 then begin sl←(w div 256)-1; sn←w mod 256 end
else begin
if sl>0 then sn←sn&(w div 256);
if sl>1 then sn←sn&(w mod 256);
sl←sl-2;
end;
end;
if not equ(sn,fam) then famno←-1;
len←0;
end;
if t=4 then begin
ffn←bytein(chan);
bbc←bytein(chan);
siz←bytein(chan);
rota←bytein(chan);
pos←bytein(chan)*(256*256); pos←pos+bytein(chan);
i←bytein(chan); i←bytein(chan);
len←0;
if ffn=famno*256+face and rota=0 and
(abs(siz-((pt*2540) div 72))<2 or (bsiz=-1 and siz=0)) then begin
bsiz←siz;
bpos←pos;
bc←bbc div 256; ec←bbc mod 256;
end;
end;
for i←1 thru len do bytein(chan);
end "readix" until t=0;
if famno=-1 or bsiz=-1 then begin
Outstr("Cannot find entry in Fonts.Widths for "&nam&crlf);
end else begin "rdw"
SFPTR(chan, bpos+3);
scale←1.0;
if bsiz=0 then scale←(2540*pt)/72000;
FNTINF[WHICH]←bytein(chan)*scale; comment char height;
t←bytein(chan);
if (t land '100000) then begin
t←bytein(chan)*scale;
for i←bc thru ec do CW[i]←t;
end else begin
for i←bc thru ec do begin
t←bytein(chan);
if t neq '100000 then CW[i]←t*scale;
end;
end;
FNTNUMBER[WHICH]←-1;
end "rdw";
end "PF"
],
Comment in USERS.SAI ;
PARCASE = [
CNVCASE["P"] ← CNVCASE["p"] ← MCASE ;
CNVCASE["L"] ← CNVCASE["l"] ← PCASE ;
CNVCASE["M"] ← CNVCASE["m"] ← 0
],
Comment in FILES.SAI;
PARCEXT = [
(CASE ABS(DEVICE)-1 OF (".LPT",".TTY",".PRESS",".XGP"))
] ,
Comment in VARBL.SAI;
PARCMNEMONIC = [
"PRESS"
] ;